#' Control Function for Descriptive Statistics

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Sets a list of parameters for summaries of descriptive statistics. Typically used internally to specify

#' details for [s_summary()]. This function family is mainly used by [analyze_vars()].

#'

#' @inheritParams argument_convention

#' @param quantiles (`numeric`)\cr of length two to specify the quantiles to calculate.

#' @param quantile_type (`numeric`)\cr between 1 and 9 selecting quantile algorithms to be used.

#'   Default is set to 2 as this matches the default quantile algorithm in SAS `proc univariate` set by `QNTLDEF=5`.

#'   This differs from R's default. See more about `type` in [stats::quantile()].

#' @param test_mean (`numeric`)\cr to test against the mean under the null hypothesis when calculating p-value.

#'

#' @return A list of components with the same names as the arguments.

#'

#' @export

control_analyze_vars <- function(conf_level = 0.95,

                                 quantiles = c(0.25, 0.75),

                                 quantile_type = 2,

                                 test_mean = 0) {

}

#' Analyze Variables

#'

#' @description `r lifecycle::badge("stable")`

#'

#' The analyze function [analyze_vars()] generates a summary of one or more variables, using the S3 generic function

#' [s_summary()] to calculate a list of summary statistics. A list of all available statistics for numeric

#' variables can be viewed by running `get_stats("analyze_vars_numeric")` and for non-numeric variables by running

#' `get_stats("analyze_vars_counts")`. Use the `.stats` parameter to specify the statistics to include in your output

#' summary table.

#'

#' @details

#' **Automatic digit formatting:** The number of digits to display can be automatically determined from the analyzed

#' variable(s) (`vars`) for certain statistics by setting the statistic format to `"auto"` in `.formats`.

#' This utilizes the [format_auto()] formatting function. Note that only data for the current row & variable (for all

#' columns) will be considered (`.df_row[[.var]]`, see [`rtables::additional_fun_params`]) and not the whole dataset.

#'

#' @inheritParams argument_convention

#' @param .stats (`character`)\cr statistics to select for the table. Run `get_stats("analyze_vars_numeric")` to see

#'   statistics available for numeric variables, and `get_stats("analyze_vars_counts")` for statistics available

#'   for non-numeric variables.

#'

#' @name analyze_variables

#' @order 1

NULL

#' @describeIn analyze_variables S3 generic function to produces a variable summary.

#'

#' @return

#' * `s_summary()` returns different statistics depending on the class of `x`.

#'

#' @export

s_summary <- function(x,

                      na.rm = TRUE, # nolint

                      denom,

                      .N_row, # nolint

                      .N_col, # nolint

                      .var,

                      ...) {

}

#' @describeIn analyze_variables Method for `numeric` class.

#'

#' @param control (`list`)\cr parameters for descriptive statistics details, specified by using

#'   the helper function [control_analyze_vars()]. Some possible parameter options are:

#'   * `conf_level` (`proportion`)\cr confidence level of the interval for mean and median.

#'   * `quantiles` (`numeric`)\cr vector of length two to specify the quantiles.

#'   * `quantile_type` (`numeric`)\cr between 1 and 9 selecting quantile algorithms to be used.

#'     See more about `type` in [stats::quantile()].

#'   * `test_mean` (`numeric`)\cr value to test against the mean under the null hypothesis when calculating p-value.

#'

#' @return

#'   * If `x` is of class `numeric`, returns a `list` with the following named `numeric` items:

#'     * `n`: The [length()] of `x`.

#'     * `sum`: The [sum()] of `x`.

#'     * `mean`: The [mean()] of `x`.

#'     * `sd`: The [stats::sd()] of `x`.

#'     * `se`: The standard error of `x` mean, i.e.: (`sd(x) / sqrt(length(x))`).

#'     * `mean_sd`: The [mean()] and [stats::sd()] of `x`.

#'     * `mean_se`: The [mean()] of `x` and its standard error (see above).

#'     * `mean_ci`: The CI for the mean of `x` (from [stat_mean_ci()]).

#'     * `mean_sei`: The SE interval for the mean of `x`, i.e.: ([mean()] -/+ [stats::sd()] / [sqrt()]).

#'     * `mean_sdi`: The SD interval for the mean of `x`, i.e.: ([mean()] -/+ [stats::sd()]).

#'     * `mean_pval`: The two-sided p-value of the mean of `x` (from [stat_mean_pval()]).

#'     * `median`: The [stats::median()] of `x`.

#'     * `mad`: The median absolute deviation of `x`, i.e.: ([stats::median()] of `xc`,

#'       where `xc` = `x` - [stats::median()]).

#'     * `median_ci`: The CI for the median of `x` (from [stat_median_ci()]).

#'     * `quantiles`: Two sample quantiles of `x` (from [stats::quantile()]).

#'     * `iqr`: The [stats::IQR()] of `x`.

#'     * `range`: The [range_noinf()] of `x`.

#'     * `min`: The [max()] of `x`.

#'     * `max`: The [min()] of `x`.

#'     * `median_range`: The [median()] and [range_noinf()] of `x`.

#'     * `cv`: The coefficient of variation of `x`, i.e.: ([stats::sd()] / [mean()] * 100).

#'     * `geom_mean`: The geometric mean of `x`, i.e.: (`exp(mean(log(x)))`).

#'     * `geom_cv`: The geometric coefficient of variation of `x`, i.e.: (`sqrt(exp(sd(log(x)) ^ 2) - 1) * 100`).

#'

#' @note

#' * If `x` is an empty vector, `NA` is returned. This is the expected feature so as to return `rcell` content in

#'   `rtables` when the intersection of a column and a row delimits an empty data selection.

#' * When the `mean` function is applied to an empty vector, `NA` will be returned instead of `NaN`, the latter

#'   being standard behavior in R.

#'

#' @method s_summary numeric

#'

#' @examples

#' # `s_summary.numeric`

#'

#' ## Basic usage: empty numeric returns NA-filled items.

#' s_summary(numeric())

#'

#' ## Management of NA values.

#' x <- c(NA_real_, 1)

#' s_summary(x, na.rm = TRUE)

#' s_summary(x, na.rm = FALSE)

#'

#' x <- c(NA_real_, 1, 2)

#' s_summary(x, stats = NULL)

#'

#' ## Benefits in `rtables` contructions:

#' dta_test <- data.frame(

#'   Group = rep(LETTERS[1:3], each = 2),

#'   sub_group = rep(letters[1:2], each = 3),

#'   x = 1:6

#' )

#'

#' ## The summary obtained in with `rtables`:

#' basic_table() %>%

#'   split_cols_by(var = "Group") %>%

#'   split_rows_by(var = "sub_group") %>%

#'   analyze(vars = "x", afun = s_summary) %>%

#'   build_table(df = dta_test)

#'

#' ## By comparison with `lapply`:

#' X <- split(dta_test, f = with(dta_test, interaction(Group, sub_group)))

#' lapply(X, function(x) s_summary(x$x))

#'

#' @export

s_summary.numeric <- function(x,

                              na.rm = TRUE, # nolint

                              denom,

                              .N_row, # nolint

                              .N_col, # nolint

                              .var,

                              control = control_analyze_vars(),

                              ...) {

  }

  } else {

  }

  ))

  # Convert negative values to NA for log calculation.

}

#' @describeIn analyze_variables Method for `factor` class.

#'

#' @param denom (`string`)\cr choice of denominator for factor proportions. Options are:

#'   * `n`: number of values in this row and column intersection.

#'   * `N_row`: total number of values in this row across columns.

#'   * `N_col`: total number of values in this column across rows.

#'

#' @return

#'   * If `x` is of class `factor` or converted from `character`, returns a `list` with named `numeric` items:

#'     * `n`: The [length()] of `x`.

#'     * `count`: A list with the number of cases for each level of the factor `x`.

#'     * `count_fraction`: Similar to `count` but also includes the proportion of cases for each level of the

#'       factor `x` relative to the denominator, or `NA` if the denominator is zero.

#'

#' @note

#' * If `x` is an empty `factor`, a list is still returned for `counts` with one element

#'   per factor level. If there are no levels in `x`, the function fails.

#' * If factor variables contain `NA`, these `NA` values are excluded by default. To include `NA` values

#'   set `na.rm = FALSE` and missing values will be displayed as an `NA` level. Alternatively, an explicit

#'   factor level can be defined for `NA` values during pre-processing via [df_explicit_na()] - the

#'   default `na_level` (`"<Missing>"`) will also be excluded when `na.rm` is set to `TRUE`.

#'

#' @method s_summary factor

#'

#' @examples

#' # `s_summary.factor`

#'

#' ## Basic usage:

#' s_summary(factor(c("a", "a", "b", "c", "a")))

#'

#' # Empty factor returns zero-filled items.

#' s_summary(factor(levels = c("a", "b", "c")))

#'

#' ## Management of NA values.

#' x <- factor(c(NA, "Female"))

#' x <- explicit_na(x)

#' s_summary(x, na.rm = TRUE)

#' s_summary(x, na.rm = FALSE)

#'

#' ## Different denominators.

#' x <- factor(c("a", "a", "b", "c", "a"))

#' s_summary(x, denom = "N_row", .N_row = 10L)

#' s_summary(x, denom = "N_col", .N_col = 20L)

#'

#' @export

s_summary.factor <- function(x,

                             na.rm = TRUE, # nolint

                             denom = c("n", "N_row", "N_col"),

                             .N_row, # nolint

                             .N_col, # nolint

                             ...) {

  } else {

  }

  )

    }

  )

}

#' @describeIn analyze_variables Method for `character` class. This makes an automatic

#'   conversion to factor (with a warning) and then forwards to the method for factors.

#'

#' @param verbose (`logical`)\cr Defaults to `TRUE`, which prints out warnings and messages. It is mainly used

#'   to print out information about factor casting.

#'

#' @note

#' * Automatic conversion of character to factor does not guarantee that the table

#'   can be generated correctly. In particular for sparse tables this very likely can fail.

#'   It is therefore better to always pre-process the dataset such that factors are manually

#'   created from character variables before passing the dataset to [rtables::build_table()].

#'

#' @method s_summary character

#'

#' @examples

#' # `s_summary.character`

#'

#' ## Basic usage:

#' s_summary(c("a", "a", "b", "c", "a"), .var = "x", verbose = FALSE)

#' s_summary(c("a", "a", "b", "c", "a", ""), .var = "x", na.rm = FALSE, verbose = FALSE)

#'

#' @export

s_summary.character <- function(x,

                                na.rm = TRUE, # nolint

                                denom = c("n", "N_row", "N_col"),

                                .N_row, # nolint

                                .N_col, # nolint

                                .var,

                                verbose = TRUE,

                                ...) {

  } else {

  }

    ...

  )

}

#' @describeIn analyze_variables Method for `logical` class.

#'

#' @param denom (`string`)\cr choice of denominator for proportion. Options are:

#'   * `n`: number of values in this row and column intersection.

#'   * `N_row`: total number of values in this row across columns.

#'   * `N_col`: total number of values in this column across rows.

#'

#' @return

#'   * If `x` is of class `logical`, returns a `list` with named `numeric` items:

#'     * `n`: The [length()] of `x` (possibly after removing `NA`s).

#'     * `count`: Count of `TRUE` in `x`.

#'     * `count_fraction`: Count and proportion of `TRUE` in `x` relative to the denominator, or `NA` if the

#'       denominator is zero. Note that `NA`s in `x` are never counted or leading to `NA` here.

#'

#' @method s_summary logical

#'

#' @examples

#' # `s_summary.logical`

#'

#' ## Basic usage:

#' s_summary(c(TRUE, FALSE, TRUE, TRUE))

#'

#' # Empty factor returns zero-filled items.

#' s_summary(as.logical(c()))

#'

#' ## Management of NA values.

#' x <- c(NA, TRUE, FALSE)

#' s_summary(x, na.rm = TRUE)

#' s_summary(x, na.rm = FALSE)

#'

#' ## Different denominators.

#' x <- c(TRUE, FALSE, TRUE, TRUE)

#' s_summary(x, denom = "N_row", .N_row = 10L)

#' s_summary(x, denom = "N_col", .N_col = 20L)

#'

#' @export

s_summary.logical <- function(x,

                              na.rm = TRUE, # nolint

                              denom = c("n", "N_row", "N_col"),

                              .N_row, # nolint

                              .N_col, # nolint

                              ...) {

  )

}

#' @describeIn analyze_variables Formatted analysis function which is used as `afun` in `analyze_vars()` and

#'   `compare_vars()` and as `cfun` in `summarize_colvars()`.

#'

#' @param compare (`logical`)\cr Whether comparison statistics should be analyzed instead of summary statistics

#'   (`compare = TRUE` adds `pval` statistic comparing against reference group).

#'

#' @return

#' * `a_summary()` returns the corresponding list with formatted [rtables::CellValue()].

#'

#' @note

#' * To use for comparison (with additional p-value statistic), parameter `compare` must be set to `TRUE`.

#' * Ensure that either all `NA` values are converted to an explicit `NA` level or all `NA` values are left as is.

#'

#' @examples

#' a_summary(factor(c("a", "a", "b", "c", "a")), .N_row = 10, .N_col = 10)

#' a_summary(

#'   factor(c("a", "a", "b", "c", "a")),

#'   .ref_group = factor(c("a", "a", "b", "c")), compare = TRUE

#' )

#'

#' a_summary(c("A", "B", "A", "C"), .var = "x", .N_col = 10, .N_row = 10, verbose = FALSE)

#' a_summary(

#'   c("A", "B", "A", "C"),

#'   .ref_group = c("B", "A", "C"), .var = "x", compare = TRUE, verbose = FALSE

#' )

#'

#' a_summary(c(TRUE, FALSE, FALSE, TRUE, TRUE), .N_row = 10, .N_col = 10)

#' a_summary(

#'   c(TRUE, FALSE, FALSE, TRUE, TRUE),

#'   .ref_group = c(TRUE, FALSE), .in_ref_col = TRUE, compare = TRUE

#' )

#'

#' a_summary(rnorm(10), .N_col = 10, .N_row = 20, .var = "bla")

#' a_summary(rnorm(10, 5, 1), .ref_group = rnorm(20, -5, 1), .var = "bla", compare = TRUE)

#'

#' @export

a_summary <- function(x,

                      .N_col, # nolint

                      .N_row, # nolint

                      .var = NULL,

                      .df_row = NULL,

                      .ref_group = NULL,

                      .in_ref_col = FALSE,

                      compare = FALSE,

                      .stats = NULL,

                      .formats = NULL,

                      .labels = NULL,

                      .indent_mods = NULL,

                      na.rm = TRUE, # nolint

                      na_str = default_na_str(),

                      ...) {

    }

  } else {

    }

  }

  # If one col has NA vals, must add NA row to other cols (using placeholder lvl `fill-na-level`)

  } else {

    )

  }

  # Fill in with formatting defaults if needed

  # Check for custom labels from control_analyze_vars

  } else {

  }

    # Ungroup statistics with values for each level of x

  }

  # Auto format handling

  )

}

#' @describeIn analyze_variables Layout-creating function which can take statistics function arguments

#'   and additional format arguments. This function is a wrapper for [rtables::analyze()].

#'

#' @param ... arguments passed to `s_summary()`.

#' @param .indent_mods (named `vector` of `integer`)\cr indent modifiers for the labels. Each element of the vector

#'   should be a name-value pair with name corresponding to a statistic specified in `.stats` and value the indentation

#'   for that statistic's row label.

#'

#' @return

#' * `analyze_vars()` returns a layout object suitable for passing to further layouting functions,

#'   or to [rtables::build_table()]. Adding this function to an `rtable` layout will add formatted rows containing

#'   the statistics from `s_summary()` to the table layout.

#'

#' @examples

#' ## Fabricated dataset.

#' dta_test <- data.frame(

#'   USUBJID = rep(1:6, each = 3),

#'   PARAMCD = rep("lab", 6 * 3),

#'   AVISIT  = rep(paste0("V", 1:3), 6),

#'   ARM     = rep(LETTERS[1:3], rep(6, 3)),

#'   AVAL    = c(9:1, rep(NA, 9))

#' )

#'

#' # `analyze_vars()` in `rtables` pipelines

#' ## Default output within a `rtables` pipeline.

#' l <- basic_table() %>%

#'   split_cols_by(var = "ARM") %>%

#'   split_rows_by(var = "AVISIT") %>%

#'   analyze_vars(vars = "AVAL")

#'

#' build_table(l, df = dta_test)

#'

#' ## Select and format statistics output.

#' l <- basic_table() %>%

#'   split_cols_by(var = "ARM") %>%

#'   split_rows_by(var = "AVISIT") %>%

#'   analyze_vars(

#'     vars = "AVAL",

#'     .stats = c("n", "mean_sd", "quantiles"),

#'     .formats = c("mean_sd" = "xx.x, xx.x"),

#'     .labels = c(n = "n", mean_sd = "Mean, SD", quantiles = c("Q1 - Q3"))

#'   )

#'

#' build_table(l, df = dta_test)

#'

#' ## Use arguments interpreted by `s_summary`.

#' l <- basic_table() %>%

#'   split_cols_by(var = "ARM") %>%

#'   split_rows_by(var = "AVISIT") %>%

#'   analyze_vars(vars = "AVAL", na.rm = FALSE)

#'

#' build_table(l, df = dta_test)

#'

#' ## Handle `NA` levels first when summarizing factors.

#' dta_test$AVISIT <- NA_character_

#' dta_test <- df_explicit_na(dta_test)

#' l <- basic_table() %>%

#'   split_cols_by(var = "ARM") %>%

#'   analyze_vars(vars = "AVISIT", na.rm = FALSE)

#'

#' build_table(l, df = dta_test)

#'

#' # auto format

#' dt <- data.frame("VAR" = c(0.001, 0.2, 0.0011000, 3, 4))

#' basic_table() %>%

#'   analyze_vars(

#'     vars = "VAR",

#'     .stats = c("n", "mean", "mean_sd", "range"),

#'     .formats = c("mean_sd" = "auto", "range" = "auto")

#'   ) %>%

#'   build_table(dt)

#'

#' @export

#' @order 2

analyze_vars <- function(lyt,

                         vars,

                         var_labels = vars,

                         na_str = default_na_str(),

                         nested = TRUE,

                         ...,

                         na.rm = TRUE, # nolint

                         show_labels = "default",

                         table_names = vars,

                         section_div = NA_character_,

                         .stats = c("n", "mean_sd", "median", "range", "count_fraction"),

                         .formats = NULL,

                         .labels = NULL,

                         .indent_mods = NULL) {

  )

}

#' Create a forest plot from an `rtable`

#'

#' Given a [rtables::rtable()] object with at least one column with a single value and one column with 2

#' values, converts table to a [ggplot2::ggplot()] object and generates an accompanying forest plot. The

#' table and forest plot are printed side-by-side.

#'

#' @description `r lifecycle::badge("stable")`

#'

#' @inheritParams rtable2gg

#' @inheritParams argument_convention

#' @param tbl (`rtable`)\cr table with at least one column with a single value and one column with 2 values.

#' @param col_x (`integer`)\cr column index with estimator. By default tries to get this from

#'   `tbl` attribute `col_x`, otherwise needs to be manually specified. If `NULL`, points will be excluded

#'   from forest plot.

#' @param col_ci (`integer`)\cr column index with confidence intervals. By default tries to get this from

#'   `tbl` attribute `col_ci`, otherwise needs to be manually specified. If `NULL`, lines will be excluded

#'   from forest plot.

#' @param vline (`numeric`)\cr x coordinate for vertical line, if `NULL` then the line is omitted.

#' @param forest_header (`character`, length 2)\cr text displayed to the left and right of `vline`, respectively.

#'   If `vline = NULL` then `forest_header` is not printed. By default tries to get this from `tbl` attribute

#'   `forest_header`. If `NULL`, defaults will be extracted from the table if possible, and set to

#'   `"Comparison\nBetter"` and `"Treatment\nBetter"` if not.

#' @param xlim (`numeric`)\cr limits for x axis.

#' @param logx (`flag`)\cr show the x-values on logarithm scale.

#' @param x_at (`numeric`)\cr x-tick locations, if `NULL`, `x_at` is set to `vline` and both `xlim` values.

#' @param width_row_names `r lifecycle::badge("deprecated")` Please use the `lbl_col_padding` argument instead.

#' @param width_columns (`vector` of `numeric`)\cr a vector of column widths. Each element's position in

#'   `colwidths` corresponds to the column of `tbl` in the same position. If `NULL`, column widths are calculated

#'   according to maximum number of characters per column.

#' @param width_forest `r lifecycle::badge("deprecated")` Please use the `rel_width_forest` argument instead.

#' @param rel_width_forest (`proportion`)\cr proportion of total width to allocate to the forest plot. Relative

#'   width of table is then `1 - rel_width_forest`. If `as_list = TRUE`, this parameter is ignored.

#' @param font_size (`numeric`)\cr font size.

#' @param col_symbol_size (`integer`)\cr column index from `tbl` containing data to be used

#'   to determine relative size for estimator plot symbol. Typically, the symbol size is proportional

#'   to the sample size used to calculate the estimator. If `NULL`, the same symbol size is used for all subgroups.

#'   By default tries to get this from `tbl` attribute `col_symbol_size`, otherwise needs to be manually specified.

#' @param col (`character`)\cr color(s).

#' @param ggtheme (`theme`)\cr a graphical theme as provided by `ggplot2` to control styling of the plot.

#' @param as_list (`flag`)\cr whether the two `ggplot` objects should be returned as a list. If `TRUE`, a named list

#'   with two elements, `table` and `plot`, will be returned. If `FALSE` (default) the table and forest plot are

#'   printed side-by-side via [cowplot::plot_grid()].

#' @param gp `r lifecycle::badge("deprecated")` `g_forest` is now generated as a `ggplot` object. This argument

#'   is no longer used.

#' @param draw `r lifecycle::badge("deprecated")` `g_forest` is now generated as a `ggplot` object. This argument

#'   is no longer used.

#' @param newpage `r lifecycle::badge("deprecated")` `g_forest` is now generated as a `ggplot` object. This argument

#'   is no longer used.

#'

#' @return `ggplot` forest plot and table.

#'

#' @examples

#' library(dplyr)

#' library(forcats)

#' library(nestcolor)

#'

#' adrs <- tern_ex_adrs

#' n_records <- 20

#' adrs_labels <- formatters::var_labels(adrs, fill = TRUE)

#' adrs <- adrs %>%

#'   filter(PARAMCD == "BESRSPI") %>%

#'   filter(ARM %in% c("A: Drug X", "B: Placebo")) %>%

#'   slice(seq_len(n_records)) %>%

#'   droplevels() %>%

#'   mutate(

#'     # Reorder levels of factor to make the placebo group the reference arm.

#'     ARM = fct_relevel(ARM, "B: Placebo"),

#'     rsp = AVALC == "CR"

#'   )

#' formatters::var_labels(adrs) <- c(adrs_labels, "Response")

#' df <- extract_rsp_subgroups(

#'   variables = list(rsp = "rsp", arm = "ARM", subgroups = c("SEX", "STRATA2")),

#'   data = adrs

#' )

#' # Full commonly used response table.

#'

#' tbl <- basic_table() %>%

#'   tabulate_rsp_subgroups(df)

#' g_forest(tbl)

#'

#' # Odds ratio only table.

#'

#' tbl_or <- basic_table() %>%

#'   tabulate_rsp_subgroups(df, vars = c("n_tot", "or", "ci"))

#' g_forest(

#'   tbl_or,

#'   forest_header = c("Comparison\nBetter", "Treatment\nBetter")

#' )

#'

#' # Survival forest plot example.

#' adtte <- tern_ex_adtte

#' # Save variable labels before data processing steps.

#' adtte_labels <- formatters::var_labels(adtte, fill = TRUE)

#' adtte_f <- adtte %>%

#'   filter(

#'     PARAMCD == "OS",

#'     ARM %in% c("B: Placebo", "A: Drug X"),

#'     SEX %in% c("M", "F")

#'   ) %>%

#'   mutate(

#'     # Reorder levels of ARM to display reference arm before treatment arm.

#'     ARM = droplevels(fct_relevel(ARM, "B: Placebo")),

#'     SEX = droplevels(SEX),

#'     AVALU = as.character(AVALU),

#'     is_event = CNSR == 0

#'   )

#' labels <- list(

#'   "ARM" = adtte_labels["ARM"],

#'   "SEX" = adtte_labels["SEX"],

#'   "AVALU" = adtte_labels["AVALU"],

#'   "is_event" = "Event Flag"

#' )

#' formatters::var_labels(adtte_f)[names(labels)] <- as.character(labels)

#' df <- extract_survival_subgroups(

#'   variables = list(

#'     tte = "AVAL",

#'     is_event = "is_event",

#'     arm = "ARM", subgroups = c("SEX", "BMRKR2")

#'   ),

#'   data = adtte_f

#' )

#' table_hr <- basic_table() %>%

#'   tabulate_survival_subgroups(df, time_unit = adtte_f$AVALU[1])

#' g_forest(table_hr)

#'

#' # Works with any `rtable`.

#' tbl <- rtable(

#'   header = c("E", "CI", "N"),

#'   rrow("", 1, c(.8, 1.2), 200),

#'   rrow("", 1.2, c(1.1, 1.4), 50)

#' )

#' g_forest(

#'   tbl = tbl,

#'   col_x = 1,

#'   col_ci = 2,

#'   xlim = c(0.5, 2),

#'   x_at = c(0.5, 1, 2),

#'   col_symbol_size = 3

#' )

#'

#' tbl <- rtable(

#'   header = rheader(

#'     rrow("", rcell("A", colspan = 2)),

#'     rrow("", "c1", "c2")

#'   ),

#'   rrow("row 1", 1, c(.8, 1.2)),

#'   rrow("row 2", 1.2, c(1.1, 1.4))

#' )

#' g_forest(

#'   tbl = tbl,

#'   col_x = 1,

#'   col_ci = 2,

#'   xlim = c(0.5, 2),

#'   x_at = c(0.5, 1, 2),

#'   vline = 1,

#'   forest_header = c("Hello", "World")

#' )

#'

#' @export

g_forest <- function(tbl,

                     col_x = attr(tbl, "col_x"),

                     col_ci = attr(tbl, "col_ci"),

                     vline = 1,

                     forest_header = attr(tbl, "forest_header"),

                     xlim = c(0.1, 10),

                     logx = TRUE,

                     x_at = c(0.1, 1, 10),

                     width_row_names = lifecycle::deprecated(),

                     width_columns = NULL,

                     width_forest = lifecycle::deprecated(),

                     lbl_col_padding = 0,

                     rel_width_forest = 0.25,

                     font_size = 12,

                     col_symbol_size = attr(tbl, "col_symbol_size"),

                     col = getOption("ggplot2.discrete.colour")[1],

                     ggtheme = NULL,

                     as_list = FALSE,

                     gp = lifecycle::deprecated(),

                     draw = lifecycle::deprecated(),

                     newpage = lifecycle::deprecated()) {

  # Deprecated argument warnings

    )

  }

    )

  }

      )

    )

  }

    )

  }

    )

  }

  # Extract info from table

  # Generate and modify table as ggplot object

  } else {

  }

  # Check table data columns

  } else {

  }

  } else {

  }

  } else {

  }

  # Apply log transformation

  } else {

  }

  # Set up plot area

    ) +

    ) +

    ) +

    )

  }

    # Set default forest header

      )

    }

    # Add vline and forest header labels

    } else {

    }

      ) +

      ) +

      )

  }

  # Add points to plot

    )

  }

    # Determine which arrow(s) to add to CI lines

    )

    # Add CI lines

        )

      } else {

        )

      }

  }

  # Apply custom ggtheme to plot

    )

  } else {

    )

  }

}

#' Forest Plot Grob

#'

#' @description `r lifecycle::badge("deprecated")`

#'

#' @inheritParams g_forest

#' @param tbl ([rtables::rtable()])

#' @param x (`numeric`)\cr coordinate of point.

#' @param lower,upper (`numeric`)\cr lower/upper bound of the confidence interval.

#' @param symbol_size (`numeric`)\cr vector with relative size for plot symbol.

#' If `NULL`, the same symbol size is used.

#'

#' @details

#' The heights get automatically determined.

#'

#' @noRd

#'

#' @examples

#' tbl <- rtable(

#'   header = rheader(

#'     rrow("", "E", rcell("CI", colspan = 2), "N"),

#'     rrow("", "A", "B", "C", "D")

#'   ),

#'   rrow("row 1", 1, 0.8, 1.1, 16),

#'   rrow("row 2", 1.4, 0.8, 1.6, 25),

#'   rrow("row 3", 1.2, 0.8, 1.6, 36)

#' )

#'

#' x <- c(1, 1.4, 1.2)

#' lower <- c(0.8, 0.8, 0.8)

#' upper <- c(1.1, 1.6, 1.6)

#' # numeric vector with multiplication factor to scale each circle radius

#' # default radius is 1/3.5 lines

#' symbol_scale <- c(1, 1.25, 1.5)

#'

#' # Internal function - forest_grob

#' \donttest{

#' p <- forest_grob(tbl, x, lower, upper,

#'   vline = 1, forest_header = c("A", "B"),

#'   x_at = c(.1, 1, 10), xlim = c(0.1, 10), logx = TRUE, symbol_size = symbol_scale,

#'   vp = grid::plotViewport(margins = c(1, 1, 1, 1))

#' )

#'

#' draw_grob(p)

#' }

forest_grob <- function(tbl,

                        x,

                        lower,

                        upper,

                        vline,

                        forest_header,

                        xlim = NULL,

                        logx = FALSE,

                        x_at = NULL,

                        width_row_names = NULL,

                        width_columns = NULL,

                        width_forest = grid::unit(1, "null"),

                        symbol_size = NULL,

                        col = "blue",

                        name = NULL,

                        gp = NULL,

                        vp = NULL) {

  )

  } else {

  }

  }

  }

    } else {

    }

    }

  } else {

  }

  # Get table content as matrix form.

  # Use `rtables` indent_string eventually.

  )

  # Pre-process the data to be used in lapply and cell_in_rows.

    } else {

    }

      )

    })

  }

      ),

      ),

      ),

      # forest part

      } else {

                # this may overflow, to fix, look here

                # https://stackoverflow.com/questions/33623169/add-multi-line-footnote-to-tablegrob-while-using-gridextra-in-r # nolint

                ),

                )

              ),

            )

          ),

        )

      },

              } else {

                )

              },

            ),

          )

        ),

      ),

              )

            },

          )

        ),

      )

    ),

  )

}

cell_in_rows <- function(row_name,

                         cells,

                         cell_spans,

                         row_index,

                         underline_colspan = FALSE) {

    )

  } else {

  }

  } else {

      }

      } else {

          )

        } else {

          # +1 because of rowname

          )

          } else {

              )

            )

          }

        }

      }

    })

  }

  )

}

#' Graphic Object: Forest Dot Line

#'

#' @description `r lifecycle::badge("deprecated")`

#'

#' Calculate the `grob` corresponding to the dot line within the forest plot.

#'

#' @noRd

forest_dot_line <- function(x,

                            lower,

                            upper,

                            row_index,

                            xlim,

                            symbol_size = 1,

                            col = "blue",

                            datavp) {

  )

    # line

      # -

        # <->

        )

        # <-

        )

        # ->

        )

      }

    } else {

    }

      )

    } else {

    }

            )

          ),

        )

      ),

    )

  } else {

  }

}

#' Create a Viewport Tree for the Forest Plot

#'

#' @description `r lifecycle::badge("deprecated")`

#'

#' @param tbl (`rtable`)

#' @param width_row_names (`grid::unit`)\cr Width of row names

#' @param width_columns (`grid::unit`)\cr Width of column spans

#' @param width_forest (`grid::unit`)\cr Width of the forest plot

#' @param gap_column (`grid::unit`)\cr Gap width between the columns

#' @param gap_header (`grid::unit`)\cr Gap width between the header

#' @param mat_form matrix print form of the table

#' @return A viewport tree.

#'

#' @examples

#' library(grid)

#'

#' tbl <- rtable(

#'   header = rheader(

#'     rrow("", "E", rcell("CI", colspan = 2)),

#'     rrow("", "A", "B", "C")

#'   ),

#'   rrow("row 1", 1, 0.8, 1.1),

#'   rrow("row 2", 1.4, 0.8, 1.6),

#'   rrow("row 3", 1.2, 0.8, 1.2)

#' )

#'

#' \donttest{

#' v <- forest_viewport(tbl)

#'

#' grid::grid.newpage()

#' showViewport(v)

#' }

#'

#' @export

forest_viewport <- function(tbl,

                            width_row_names = NULL,

                            width_columns = NULL,

                            width_forest = grid::unit(1, "null"),

                            gap_column = grid::unit(1, "lines"),

                            gap_header = grid::unit(1, "lines"),

                            mat_form = NULL) {

  )